home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0076_LONG String Arrays.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  4KB  |  174 lines
  1.  
  2. {
  3. GV> Hi Wim,
  4. Hi Greg...
  5.  
  6. GV> It wouldn't be difficult to write Pos, Copy, Assign, etc., which
  7. GV> operate on an ARRAY OF CHAR -- using the ASCIIZ scheme, or a length
  8. GV> WORD (rather than length byte) at array elements [0] and [1].
  9.  
  10. As you can see in a other message has wim van der vegt written a
  11. complete unit with these functions :-)
  12.  
  13. it was a 'little' bit reprogramming to implement these new functions but
  14. it was worth while <g>
  15.  
  16. GV> Greg_
  17. Thanx for your answer, Wim
  18.  
  19. here is the code :
  20. }
  21.  
  22. Unit MyStr;
  23.  
  24. INTERFACE
  25.  
  26.  
  27. Const
  28.   maxlength  = 512;
  29.   nul        = #00;
  30.   cr         = #13;
  31.   lf         = #10;
  32.   sp         = #32;
  33.  
  34. Type
  35.   indexrange = 0..maxlength;
  36.   stringtype = Record
  37.                  length : indexrange;
  38.                  chars  : Array[1..maxlength] Of char;
  39.                End;
  40.  
  41.  
  42. Function  Long_Length(s : stringtype) : indexrange;
  43. Procedure Long_Readln(Var f : text;var l : stringtype);
  44. Procedure Long_Write(Var f : text;var l : stringtype);
  45. Procedure Long_Writeln(Var f : text;var l : stringtype);
  46. Procedure Long_Copy(s : stringtype;Var d : stringtype; index,count : indexrange);
  47. Procedure Long_Concat(Var d : stringtype;s : String);
  48.  
  49. IMPLEMENTATION
  50. {---------------------------------------------------------}
  51. {  Author  : Ir. G.W. van der Vegt                        }
  52. {  Project : Longer strings                               }
  53. {  Source  : Pascal + Data Structures by Dale/Lilly       }
  54. {            ISBN 0-669-07239-7                           }
  55. {---------------------------------------------------------}
  56. {  Modified to give less errors and act more like TP's    }
  57. {  functions. Can be made more efficient by using move,   }
  58. {  moving the inc of length's out of the for loops and    }
  59. {  not using the Length function to calc the length but   }
  60. {  use the field in the record. etc.                      }
  61. {---------------------------------------------------------}
  62. {  Because Turbo Pascal's Functions won't return records  }
  63. {  most of the Turbo Pascal String functions equivalents  }
  64. {  can only be procedures.                                }
  65. {---------------------------------------------------------}
  66. {  The code hasn't been tested well yet so expect some    }
  67. {  errors to be in it. All I have detected are fixed.     }
  68. {  For testing set maxlength at 20 or 30.                 }
  69. {---------------------------------------------------------}
  70.  
  71.  
  72. Function Long_Length(s : stringtype) : indexrange;
  73.  
  74. Begin
  75.   Long_Length:=s.length;
  76. End;
  77.  
  78. Procedure Long_Readln(Var f : text;var l : stringtype);
  79.  
  80. Begin
  81.   l.length:=0;
  82.   Fillchar(l.chars,maxlength,sp);
  83.   While NOT(Eoln(f) OR Eof(f)) AND (l.length<maxlength) Do
  84.     Begin
  85.       Inc(l.length,1);
  86.       System.Read(f,l.chars[l.length]);
  87.     End;
  88.  
  89.   IF Not(eof(f)) Then System.readln(f);
  90. End;
  91.  
  92. Procedure Long_Write(Var f : text;var l : stringtype);
  93.  
  94. Var
  95.   pos : indexrange;
  96.  
  97. Begin
  98.   For pos:=1 To Long_Length(l) DO
  99.     System.Write(f,l.chars[pos]);
  100. End;
  101.  
  102. Procedure Long_Writeln(Var f : text;var l : stringtype);
  103.  
  104. Var
  105.   pos : indexrange;
  106.  
  107. Begin
  108.   For pos:=1 To Long_Length(l) DO
  109.     System.Write(f,l.chars[pos]);
  110.   System.Write(f,cr,lf);
  111. End;
  112.  
  113. Procedure Long_Copy(s : stringtype;Var d : stringtype; index,count : indexrange);
  114.  
  115. Var
  116.   poss,
  117.   posd : indexrange;
  118.  
  119. Begin
  120.   d.length:=0;
  121.   Fillchar(d.chars,maxlength,sp);
  122.  
  123.   posd:=0;
  124.   poss:=index;
  125.  
  126.   WHILE (posd<count) AND (poss<=maxlength) Do
  127.     Begin
  128.       Inc(d.length,1);
  129.       Inc(posd,1);
  130.       d.chars[posd]:=s.chars[poss];
  131.       Inc(poss,1);
  132.     End;
  133. End;
  134.  
  135. Procedure Long_Concat(Var d : stringtype;s : String);
  136.  
  137. Var
  138.   posd,
  139.   poss : indexrange;
  140. Begin
  141.   posd:=Long_Length(d);
  142.   poss:=0;
  143.   While (posd<maxlength) AND (poss<Length(s)) Do
  144.     Begin
  145.       Inc(poss,1);
  146.       Inc(posd,1);
  147.       d.chars[posd]:=s[poss];
  148.       Inc(d.length,1);
  149.     End;
  150. End;
  151.  
  152.  
  153.  
  154. (*
  155. Var
  156.   inf : text;
  157.   s,d : stringtype;
  158.  
  159. Begin
  160.   Assign(inf,'LSTRING.PAS');
  161.   Reset(inf);
  162.   While NOT(eof(inf)) Do
  163.     Begin
  164.       Readln(inf,s);
  165.       Copy(s,d,1,4);
  166.       Writeln(output,s);
  167.       Writeln(output,d);
  168.       Concat(d,s);
  169.       Writeln(output,d);
  170.     End;
  171. *)
  172.  
  173. End.
  174.